10 ' Financial Operating System
15 '
20 ' Daune J. Brummel
30 ' Rt. 2   Brooklyn, Wis. 52521.   Rev. 01/13/82   VER. 1.2
31 '
32 ' Enter the disk drive designation on Line 65 to specify on which drive
33 '  you want FOS and its data files to reside on.  You must also change
34 '  line 25 of FOS2 program.  Both programs set up for drive A initially.
35 '
40 DEF SEG=0:A=PEEK(&H417):POKE &H417,(A AND &H9F) OR &H60:DEF SEG
50 KEY OFF:WIDTH 80:SCREEN 0,0,0
60 CLEAR
64 '
65 DRIVE$="A"
66 '
70 ON KEY(1) GOSUB 5400:KEY(1) ON:ON KEY(9) GOSUB 5440:ON KEY(10) GOSUB 5450
80 ON KEY(2) GOSUB 5410:KEY(2) ON:ON ERROR GOTO 5370
90 COLOR 7,0:K1%=0:GOSUB 6570
100 PRINT CHR$(201)+STRING$(78,205)+CHR$(187);:PRINT CHR$(186);:PRINT TAB(14);
110 PRINT"F I N A N C I A L    O P E R A T I N G    S Y S T E M";
120 PRINT TAB(80) CHR$(186);:PRINT CHR$(200)+STRING$(78,205)+CHR$(188);
130 PRINT:PRINT
140 PRINT"     1 - Display totals for all accounts.":PRINT
150 PRINT"     2 - Checking Account # 1. (1983)
160 PRINT"     3 - Checking Account # 2. (Bank of Mad. Partnership Acct.)
170 PRINT"     4 - Checking Account # 3. (1982)":PRINT
180 PRINT"     5 - Savings Account # 1.
190 PRINT"     6 - Savings Account # 2.":PRINT
200 PRINT"     7 - Special Accounts.":PRINT
210 PRINT"     8 - Cash Expenditures.":PRINT
220 PRINT"     9 - File Maintenance and Data Analysis."
230 PRINT
240 COLOR 18:PRINT TAB(25)"   Enter function desired:  ",:COLOR 7:SOUND 800,.5
250 KB$=INKEY$:IF KB$="" THEN 250
260 IF K1%=1 THEN 5410
270 IF KB$="1" THEN 4890
280 IF KB$="2" THEN A%=1:GOSUB 5980:GOSUB 6530:GOTO 1020
290 IF KB$="3" THEN A%=2:GOSUB 5990:GOSUB 6540:GOTO 1020
300 IF KB$="4" THEN A%=3:GOSUB 6000:GOSUB 6550:GOTO 1020
310 IF KB$="5" THEN A%=1:GOSUB 5710:GOTO 380
320 IF KB$="6" THEN A%=2:GOSUB 5720:GOTO 380
330 IF KB$="7" THEN GOSUB 5610:GOTO 3270
340 IF KB$="8" THEN GOSUB 5970:GOTO 4030
350 IF KB$="9" THEN CLS:LOCATE 10,20:GOTO 370
360 BEEP : GOTO 60
370 PRINT"Loading FOS Program section 2...":CHAIN DRIVE$+":FOS2"
380 GET#1,1:IF A$="E" OR A$="B" OR A$="A" THEN 410 ELSE CLS:BEEP
390 PRINT:PRINT"This Savings account must be INITIALIZED before it can be used.
400 CLOSE:GOSUB 6630:GOTO 60
410 GOSUB 6570:K1%=0:IF A%=1 THEN GOSUB 5810
420 IF A%=2 THEN GOSUB 5830
430 PRINT:PRINT
440 PRINT"     1 - Display transactions and balance."
450 PRINT:PRINT"     2 - Enter a Deposit or Withdrawal."
460 PRINT:PRINT"     3 - Delete the last entry.
470 PRINT:PRINT"     4 - Add an interest payment to the account."
480 PRINT:PRINT:PRINT
490 COLOR 18:PRINT TAB(28)"Enter function desired:   ",:COLOR 7
500 SOUND 1200,.5
510 KB$=INKEY$:IF KB$="" THEN 510
520 IF K1%=1 THEN CLOSE:GOTO 60
530 IF KB$="1" THEN 780
540 IF KB$="2" THEN 580
550 IF KB$="3" THEN 830
560 IF KB$="4" THEN 950
570 BEEP:GOTO 510
580 A#=0:CLS:GOSUB 5460:PRINT:IF K1%=1 THEN 410
590 PRINT"  Is this a Deposit (D), or a Withdrawal (W)  ";
600 INPUT KB$:IF K1%=1 THEN 410
610 IF KB$="W" OR KB$="w" THEN B%=1:GOTO 640
620 IF KB$="D" OR KB$="d" THEN B%=2:GOTO 640
630 BEEP:GOTO 590
640 PRINT:INPUT"  Enter amount:  ",KB#
650 IF K1%=1 THEN 410
660 PRINT:PRINT"  Enter up to 36 characters for a description."
670 PRINT "  ------------------------------------"
680 INPUT"  ",KB$:IF K1%=1 THEN 410
690 IF LEN(KB$)<37 THEN 710
700 BEEP:GOTO 680
710 GOSUB 5740
720 LSET A$="B":LSET B$=FDATE$:LSET C$=MKD$(KB#):LSET G$=KB$
730 IF B%=2 THEN 750
740 LSET D$="W":A#=A#-KB#:LSET E$=MKD$(A#):GOTO 760
750 LSET D$="D":A#=A#+KB#:LSET E$=MKD$(A#)
760 PUT #1,R%
770 GOTO 410
780 GOSUB 6570:IF A%=1 THEN GOSUB 5850 ELSE GOSUB 5860
790 GOSUB 5670:R%=0
800 R%=R%+1:GET#1,R%
810 IF A$="A" THEN GOSUB 6630:GOTO 410
820 GOSUB 5870:GOTO 800
830 GOSUB 6570
840 PRINT"To DELETE the last entry ... enter the word 'PROCEED' :";
850 INPUT"",KB$:IF KB$="PROCEED" OR KB$="proceed" THEN 880
860 IF K1%=1 THEN 410
870 BEEP:GOTO 830
880 R%=1:GET#1,20:IF A$="A" THEN 900
890 R%=20:GOTO 940
900 IF R%=20 THEN 930
910 GET#1,R%:IF A$="A" THEN 930
920 R%=R%+1:GOTO 900
930 IF R%=1 THEN 410 ELSE R%=R%-1
940 LSET A$="A":LSET E$=MKD$(0):PUT#1,R%:GOTO 410
950 GOSUB 6570:K1%=0
960 PRINT"  Enter amount of interest to be credited to this SAVINGS ACCOUNT: ";
970 INPUT"",KB#:IF K1%=1 THEN 410
980 GOSUB 5460:IF K1%=1 THEN 410
990 GOSUB 5740:LSET A$="B":LSET B$=FDATE$:LSET D$="D":LSET C$=MKD$(KB#)
1000 A#=A#+KB#:LSET E$=MKD$(A#):LSET G$="Interest transaction only."
1010 PUT#1,R%:GOTO 410
1020 GET#1,1:IF A$="E" OR A$="B" OR A$="A" THEN 1050 ELSE CLS:BEEP
1030 PRINT"This Checking account must be INITIALIZED before it can be used.
1040 CLOSE:GOSUB 6630:GOTO 60
1050 GOSUB 6570:K1%=0:IF A%=1 THEN GOSUB 5910:GOTO 1080
1060 IF A%=2 THEN GOSUB 5930:GOTO 1080
1070 GOSUB 5950
1080 PRINT:PRINT
1090 PRINT:PRINT"  1 - Display outstanding checks and checkbook balance.":PRINT
1100 PRINT"  2 - Print outstanding checks and checkbook balance on printer.
1110 PRINT:PRINT"  3 - Credit entries.
1120 PRINT:PRINT"  4 - Debit entries.
1130 PRINT:PRINT"  5 - Balance checkbook.
1140 PRINT:PRINT"  6 - Delete an entry (outstanding check file).
1150 PRINT:PRINT"  7 - Display canceled checks.
1160 PRINT:PRINT"  8 - Print canceled check file on printer.":PRINT
1170 COLOR 18:PRINT TAB(25)"Enter function desired:  ";:COLOR 7:SOUND 1200,.5
1180 KB$=INKEY$:IF KB$="" THEN 1180
1190 IF K1%=1 THEN CLOSE:GOTO 60
1200 IF KB$="1" THEN 1770
1210 IF KB$="2" THEN 1580
1220 IF KB$="8" THEN 1290
1230 IF KB$="3" THEN 1930
1240 IF KB$="4" THEN R%=1:GOTO 2050
1250 IF KB$="5" THEN 2840
1260 IF KB$="6" THEN 2410
1270 IF KB$="7" THEN 2590
1280 BEEP:GOTO 1180
1290 GET#2,1:IF H$="E" OR H$="B" OR H$="A" THEN 1300 ELSE 2850
1300 IF A%=1 THEN KB1$="Checking Account #1, Canceled Cks.":GOTO 1330
1310 IF A%=2 THEN KB1$="Checking Account #2, Canceled Cks.":GOTO 1330
1320 KB1$="Checking Account #3, Canceled Cks."
1330 KEY(9) ON:KEY(10) ON:R%=0
1340 GOSUB 6570:GOSUB 6670:IF K1%=1 THEN 1050
1350 GOSUB 6780:IF K1%=1 THEN 1050
1360 B%=0:E%=1:PRINT:PRINT"  Insure that the printer is ready."
1370 SOUND 500,1:GOSUB 6630:IF K1%=1 THEN 1050
1380 CLS:PRINT:PRINT"  To temporarily stop the printer, press the F9 key.
1390 PRINT:PRINT"  To STOP the printer and return to MENU, press the 'F1' key.
1400 GOSUB 6600
1410 R%=R%+1:GET#2,R%:IF H$="E" THEN 1540
1420 IF H$="A" THEN 1410
1430 IF K1%=1 THEN 1050
1440 IF K9%=1 THEN LOCATE 24,5:PRINT"Printer stopped by F9 key, to continue press F10 key.";:GOTO 1430
1450 Y3$=RIGHT$(I$,2):D3$=LEFT$(I$,2)+MID$(I$,4,2)
1460 IF Y1$=Y2$ THEN 1500
1470 IF Y3$=Y1$ THEN 1560
1480 IF Y3$=Y2$ THEN 1570
1490 IF Y3$>Y1$ AND Y3$<Y2$ THEN 1520 ELSE 1410
1500 IF Y3$<>Y2$ THEN 1410
1510 IF D3$<D1$ OR D3$>D2$ THEN 1410
1520 GOSUB 6210:B%=B%+1:IF B%< 58 THEN 1410
1530 B%=0:E%=E%+1:LPRINT CHR$(140):GOTO 1400
1540 KEY(9) OFF:KEY(10) OFF:LPRINT"* * END OF CANCELED CHECK FILE * *"
1550 LPRINT CHR$(140):GOTO 1050
1560 IF D3$=>D1$ THEN 1520 ELSE 1410
1570 IF D3$>D2$ THEN 1410 ELSE 1520
1580 IF A%=1 THEN KB1$="Checking Account #1, Outstanding Cks.":GOTO 1610
1590 IF A%=2 THEN KB1$="Checking Account #2, Outstanding Cks.":GOTO 1610
1600 KB1$="Checking Account #3, Outstanding Cks."
1610 KEY(9) ON:KEY(10) ON:R%=1
1620 K1%=0:GOSUB 6570:B%=0:E%=1:PRINT"  Insure that the printer is ready.
1630 SOUND 500,1:GOSUB 6630:IF K1%=1 THEN 1050
1640 CLS:PRINT:PRINT"  To temporarily stop the printer, press the F9 key.
1650 PRINT:PRINT"  To stop the printer and return to MENU, press the F1 key.
1660 GOSUB 6580:GET#1,R%:GOSUB 6150:B#=A#
1670 R%=R%+1:GET#1,R%:IF A$="A" THEN 1670
1680 IF A$="E" THEN 1740
1690 IF K1%=1 THEN 1050
1700 IF K9%=1 THEN LOCATE 24,5:PRINT"Printer stopped by F9 key... To continue, press F10 key.";:GOTO 1690
1710 GOSUB 6150:B%=B%+1:IF C%=2 THEN B#=B#+A# ELSE B#=B#-A#
1720 IF B%<57 THEN 1670
1730 B%=0:E%=E%+1:LPRINT CHR$(140):GOTO 1660
1740 KEY(9) OFF:KEY(10) OFF
1750 LPRINT "  Current Checking Account Balance is: ";
1760 LPRINT USING"$$#######,.##";B#:LPRINT CHR$(140):GOTO 1050
1770 GOSUB 6570:IF A%=1 THEN GOSUB 6290:GOTO 1800
1780 IF A%=2 THEN GOSUB 6300:GOTO 1800
1790 GOSUB 6310
1800 GOSUB 6040:R%=1:B%=0:B#=0
1810 GET#1,1:GOSUB 6120:B#=CVD(C$)
1820 R%=R%+1:GET#1,R%
1830 IF A$="E" THEN 1910
1840 IF A$="A" THEN 1820
1850 GOSUB 6120:IF C%=2 THEN B#=B#+A# ELSE B#=B#-A#
1860 B%=B%+1:IF B%<19 THEN 1820
1870 GOSUB 6630:IF K1%=1 THEN 1050
1880 B%=0:GOSUB 6570:IF A%=1 THEN GOSUB 6290:GOTO 1900
1890 IF A%=2 THEN GOSUB 6300 ELSE GOSUB 6310
1900 GOSUB 6040:GOTO 1820
1910 PRINT:PRINT"  Current Checking account balance is: ";
1920 PRINT USING"$$#######,.##";B#:GOSUB 6630:CLS:GOTO 1050
1930 GOSUB 6570:PRINT"  This function is for making a ";:COLOR 26
1940 PRINT"DEPOSIT";:COLOR 7:PRINT" into a checking account.
1950 PRINT:IF K1%=1 THEN 1050
1960 R%=1:GOSUB 5460:IF K1%=1 THEN 1050
1970 PRINT:INPUT"  Enter amount of deposit:  ",KB#:IF K1%=1 THEN 1050
1980 R%=R%+1:GET#1,R%:IF A$="E" THEN 2040
1990 IF A$<>"A" THEN 1980
2000 PRINT:PRINT"  This deposit has been assigned ITEM #:";R%:PRINT
2010 LSET A$="B":LSET B$=FDATE$:LSET C$=MKD$(KB#):LSET D$=MKI$(R%)
2020 LSET E$=MKI$(2):LSET F$="N":LSET G$="Deposit":PUT#1,R%
2030 PRINT:GOSUB 6630:GOTO 1050
2040 BEEP:PRINT:COLOR 30:PRINT"Checking account file is full.  This deposit has NOT been added to the file.":COLOR 7:GOTO 2030
2050 GOSUB 6570:GOSUB 6330:PRINT
2060 R%=R%+1:GET#1,R%:IF A$="E" THEN 2390
2070 IF A$<>"A" THEN 2060 ELSE SOUND 1500,.1
2080 IF MC1%=0 THEN 2150 ELSE SOUND 700,1
2090 PRINT"Continuation of check #"KB2%"           Amount entered so far:";
2100 PRINT USING"$$######,.##";KB2#
2110 PRINT"  Continue entering multible expenses against this check ? (Y or N) ";
2120 KB$=INKEY$:IF KB$="" THEN 2120
2130 IF KB$="n" OR KB$="N" THEN K1%=0:MC1%=0:GOTO 2050
2140 IF KB$="Y" OR KB$="y" THEN 2210 ELSE BEEP:GOTO 2110
2150 PRINT"Enter ITEM No.[+], or just ENTER to have me assign an item No.: ";
2160 X%=POS(0):Y%=CSRLIN:INPUT"",KB$:IF K1%=1 THEN 1050
2170 IF LEN(KB$)=0 THEN LSET D$=MKI$(R%):LOCATE Y%,X%:PRINT R%:GOTO 2220
2180 IF VAL(KB$)<200 OR VAL(KB$)>32767 THEN BEEP:GOTO 2150
2190 KB2%=VAL(KB$)
2200 IF RIGHT$(KB$,1)="+" THEN MC1%=1:KB2#=0
2210 LSET D$=MKI$(KB2%)
2220 IF MC1%=1 THEN LSET A$="M" ELSE LSET A$="B"
2230 GOSUB 5470:IF K1%=1 THEN 1050
2240 LSET B$=FDATE$:PRINT TAB(41)"_____________________________________"
2250 INPUT"  Enter up to 37 Char. for description: ",KB$:IF K1%=1 THEN 1050
2260 IF LEN(KB$)<38 THEN 2280
2270 BEEP:GOTO 2250
2280 LSET G$=KB$:INPUT"  Enter AMOUNT: ",KB#:KB2#=KB2#+KB#:IF K1%=1 THEN 1050
2290 LSET C$=MKD$(KB#):INPUT"  Enter EXPENSE CODE: ",KB%:IF K1%=1 THEN 1050
2300 IF KB%>9 AND KB%<46 THEN 2320
2310 BEEP:GOTO 2290
2320 LSET E$=MKI$(KB%):PRINT"  Enter a 'Y' if this item could be a tax ";
2330 INPUT" deduction: ",KB$:IF K1%=1 THEN 1050
2340 IF MC1%=1 THEN 2370
2350 IF KB$="y" OR KB$="Y" THEN LSET F$="Y" ELSE LSET F$="N"
2360 PUT#1,R%:GOTO 2050
2370 IF KB$="y" OR KB$="Y" THEN LSET F$="y" ELSE LSET F$="n"
2380 GOTO 2360
2390 BEEP:PRINT:COLOR 30:PRINT"This checking account file is full.
2400 COLOR 7:PRINT:GOSUB 6630: GOTO 1050
2410 GOSUB 6570:PRINT:PRINT:F1%=0:F2%=0
2420 INPUT"  Enter ITEM No. of the item to be DELETED from the file: ",KB%
2430 IF K1%=1 THEN 1050
2440 IF KB%<2 THEN BEEP:GOTO 2420
2450 PRINT:INPUT"  To delete this item, enter the word 'PROCEED': ",KB$
2460 IF K1%=1 THEN 1050
2470 IF KB$="proceed" OR KB$="PROCEED" THEN 2480 ELSE BEEP:GOTO 2450
2480 R%=1:IF KB%>199 THEN 2510
2490 GET#1,KB%:IF A$="B" AND CVI(D$)=KB% THEN 2500 ELSE 2570
2500 LSET A$="A":PUT#1,KB%:GOTO 1050
2510 R%=R%+1:GET#1,R%:IF A$="E" THEN 2560
2520 IF A$="A" THEN 2510
2530 IF CVI(D$)<>KB% THEN 2510
2540 IF A$="M" THEN F1%=1
2550 LSET A$="A":PUT#1,R%:F2%=1:IF F1%=1 THEN 2510 ESLE 1040
2560 IF F2%=1 THEN 1050
2570 BEEP:PRINT:COLOR 30:PRINT"  ITEM NOT ON FILE...":COLOR 7:PRINT:GOSUB 6630
2580 GOTO 1050
2590 GET#2,1:IF H$="E" OR H$="B" OR H$="A" THEN 2600 ELSE 2850
2600 GOSUB 6570:GOSUB 6670:IF K1%=1 THEN 1050
2610 GOSUB 6780:IF K1%=1 THEN 1050 ELSE GOSUB 6570
2620 R%=0:B%=0:IF A%=1 THEN GOSUB 6240:GOTO 2650
2630 IF A%=2 THEN GOSUB 6250:GOTO 2650
2640 GOSUB 6260
2650 GOSUB 6040
2660 R%=R%+1:GET#2,R%:IF H$="E" THEN 2810
2670 IF H$="A" THEN 2660
2680 IF K1%=1 THEN 1050
2690 Y3$=RIGHT$(I$,2):D3$=LEFT$(I$,2)+MID$(I$,4,2)
2700 IF Y1$=Y2$ THEN 2740
2710 IF Y3$=Y1$ THEN 2820
2720 IF Y3$=Y2$ THEN 2830
2730 IF Y3$>Y1$ AND Y3$<Y2$ THEN 2760 ELSE 2660
2740 IF Y3$<>Y2$ THEN 2660
2750 IF D3$<D1$ OR D3$>D2$ THEN 2660
2760 GOSUB 6180
2770 B%=B%+1:IF B%<20 THEN 2660
2780 B%=0:GOSUB 6630:IF K1%=1 THEN 1050
2790 GOSUB 6570:IF A%=1 THEN GOSUB 6240:GOTO 2650
2800 IF A%=2 THEN GOSUB 6250:GOTO 2650
2805 IF A%=3 THEN GOSUB 6260:GOTO 2650
2810 PRINT"* * END OF CANCELED CHECK FILE * *":GOSUB 6630:GOTO 1050
2820 IF D3$=>D1$ THEN 2760 ELSE 2660
2830 IF D3$>D2$ THEN 2660 ELSE 2760
2840 GET#2,1:IF H$="E" OR H$="B" OR H$="A" THEN 2870
2850 CLS:BEEP:PRINT"Canceled checks file must be INITIALIZED before it can be used.
2860 GOSUB 6630:GOTO 1050
2870 CLS:R%=0:PRINT"Reading cancelled check file... please stand by.
2880 R%=R%+1:GET#2,R%:IF H$="E" THEN 3170
2890 IF H$<>"A" THEN 2880
2900 GOSUB 6570:GET#1,1:A#=CVD(C$)
2910 MC1%=0:SOUND 300,.5:INPUT"  Enter ITEM No... or a 'zero' if last item: ",KB%
2920 IF K1%=1 THEN 3120
2930 IF KB%=1 THEN BEEP:GOTO 2910
2940 IF KB%=0 THEN 3120
2950 IF KB%>199 THEN 3210
2960 GET#1,KB%:IF A$="B" AND CVI(D$)=KB% THEN 2970 ELSE 3200
2970 LSET A$="A":PUT#1,KB%
2980 IF CVI(E$)=2 THEN A#=A#+CVD(C$):GOTO 2910
2990 LSET H$="B":LSET I$=B$:LSET J$=C$:LSET K$=D$
3000 LSET L$=E$:LSET M$=F$:LSET N$=G$:PUT#2,R%
3010 A#=A#-CVD(C$)
3020 R%=R%+1:GET#2,R%:IF H$="E" THEN 3040
3030 IF MC1%=1 THEN 3220 ELSE 2910
3040 IF MC1%=1 THEN 3070
3050 PRINT:COLOR 30:PRINT"Cancelled check file is now full.":COLOR 7
3060 BEEP:BEEP:PRINT:GOTO 3120
3070 PRINT:COLOR 30:PRINT"Canceled check file is now full...
3080 PRINT"Some entries for item#"KB%"may not have been processed.
3090 PRINT"Check current check files to be sure all entries have been moved
3100 PRINT"to the canceled check file.  If not, re-enter the item after
3110 PRINT"enlarging the canceled check file.":COLOR 7:GOTO 3060
3120 PRINT:PRINT"  If balance shown on bank statement is ";
3130 PRINT USING"$$######,.##";A#;:PRINT"    then checkbook balanced OK.
3140 LSET A$="B":GOSUB 6320:LSET B$=FDATE$:LSET C$=MKD$(A#):LSET D$=MKI$(1)
3150 LSET E$=MKI$(1):LSET F$="N":LSET G$="Previous balance.":PUT#1,1
3160 PRINT:GOSUB 6630:GOTO 1050
3170 PRINT:COLOR 30:PRINT"Cancelled check file is now full.":COLOR 7
3180 BEEP:BEEP:PRINT:GOSUB 6630:GOTO 1050
3190 IF MC1%=1 THEN 2910
3200 BEEP:COLOR 26:PRINT"ITEM NOT ON FILE.":COLOR 7:GOTO 2910
3210 B%=1
3220 B%=B%+1:GET#1,B%:IF A$="E" THEN 3190
3230 IF A$="A" THEN 3220
3240 IF CVI(D$)<>KB% THEN 3220
3250 IF A$="M" THEN MC1%=1
3260 LSET A$="A":PUT#1,B%:GOTO 2990
3270 GET#1,1:IF A$="E" OR A$="B" OR A$="A" THEN 3300 ELSE CLS:BEEP
3280 PRINT"This Special account must be INITIALIZED before it can be used.
3290 CLOSE:GOSUB 6630:GOTO 60
3300 K1%=0:GOSUB 6570:PRINT:PRINT:PRINT TAB(18);:COLOR 1
3310 PRINT"        S P E C I A L       A C C O U N T S       ":COLOR 7
3320 PRINT:PRINT:PRINT:PRINT
3330 PRINT"     1 - Display items."
3340 PRINT:PRINT"     2 - Change an existing item."
3350 PRINT:PRINT"     3 - Enter a new item."
3360 PRINT:PRINT"     4 - Delete an item."
3370 PRINT:PRINT:PRINT
3380 PRINT TAB(25)"Enter function desired:  ";:SOUND 1200,.5
3390 KB$=INKEY$:IF KB$="" THEN 3390
3400 IF K1%=1 THEN CLOSE:GOTO 60
3410 GOSUB 6570:IF KB$="1" THEN 3460
3420 IF KB$="3" THEN 3570
3430 IF KB$="4" THEN 3840
3440 IF KB$="2" THEN 3960
3450 BEEP:GOTO 3300
3460 COLOR 18:PRINT"Special accounts.":COLOR 7:GOSUB 5570:R%=0:LCNT%=0:A#=0
3470 R%=R%+1:GET#1,R%
3480 IF A$="E" THEN 3550
3490 IF A$="A" THEN 3470
3500 GOSUB 5630:IF D$="A" THEN A#=A#+CVD(C$):GOTO 3520
3510 IF D$="L" THEN A#=A#-CVD(C$)
3520 LCNT%=LCNT%+1:IF LCNT%<19 THEN 3470
3530 LCNT%=0:GOSUB 6630:IF K1%=1 THEN 3300
3540 GOSUB 6570:GOSUB 5570:GOTO 3470
3550 PRINT:PRINT"  SPECIAL ACCOUNTS  TOTAL VALUE...  ";
3560 PRINT USING"$$#######,.##";A#:PRINT:GOSUB 6630:GOTO 3300
3570 K1%=0:PRINT:PRINT"  Reading file...  Please stand-by!":R%=0
3580 R%=R%+1:GET#1,R%
3590 IF A$="E" THEN 3820
3600 IF A$<>"A" THEN 3580
3610 GOSUB 6570
3620 GOSUB 5460
3630 PRINT:IF K1%=1 THEN 3300
3640 INPUT"  Is item an asset (A), or a liability (L) ?  ",KB$
3650 IF KB$="A" OR KB$="L" THEN 3710
3660 IF KB$="a" THEN 3690
3670 IF KB$="l" THEN 3700
3680 BEEP:GOTO 3630
3690 KB$="A":GOTO 3710
3700 KB$="L"
3710 LSET D$=KB$
3720 PRINT:IF K1%=1 THEN 3300
3730 INPUT"  Dollar value of item:  ",KB#
3740 LSET C$=MKD$(KB#):PRINT:IF K1%=1 THEN 3300
3750 INPUT"  Interest rate:         ",KB:LSET E$=MKS$(KB)
3760 PRINT:PRINT "  Enter up to 40 characters for a description of this item:"
3770 PRINT:PRINT "  ----------------------------------------"
3780 IF K1%=1 THEN 3300
3790 INPUT"  ",KB$:IF LEN(KB$)<41 THEN 3810
3800 BEEP:GOTO 3760
3810 LSET A$="B":LSET B$=FDATE$:LSET G$=KB$:PUT#1,R%:GOTO 3300
3820 PRINT:PRINT:COLOR 30:PRINT"SPECIAL ACCOUNTS FILE IS FULL..."
3830 COLOR 7:BEEP:GOSUB 6630:GOTO 3300
3840 PRINT"  This function will delete an item from the SPECIAL ACCOUNTS FILE."
3850 K1%=0:PRINT:PRINT
3860 PRINT "  Enter item number to be deleted:  ",:INPUT"",R%
3870 IF K1%=1 THEN 3300
3880 IF R%=0 THEN BEEP:GOTO 3860
3890 PRINT:INPUT"  To delete this item, enter the word 'PROCEED': ",KB$
3900 IF K1%=1 THEN 3300
3910 IF KB$="proceed" OR KB$="PROCEED" THEN 3920 ELSE BEEP:GOTO 3890
3920 GET#1,R%:IF A$<>"B" THEN 3940
3930 LSET A$="A":PUT#1,R%:GOTO 3300
3940 PRINT:COLOR 15:PRINT"Item not on file...":COLOR 7:BEEP
3950 GOSUB 6630:GOTO 3300
3960 K1%=0:PRINT:PRINT"  Enter the number of the item to be modified:  ";
3970 INPUT"",R%:IF K1%=1 THEN 3300
3980 IF R%>0 THEN 4000
3990 BEEP:GOTO 3960
4000 GET#1,R%:IF A$<>"B" THEN 3940
4010 PRINT:GOSUB 5570:GOSUB 5630:PRINT
4020 PRINT"  Enter new data . . .":PRINT:GOTO 3620
4030 GET#1,1:IF A$="E" OR A$="B" OR A$="A" THEN 4060 ELSE CLS:BEEP
4040 PRINT"Cash Expenditures account must be INITIALIZED before it can be used.
4050 CLOSE:GOSUB 6630:GOTO 60
4060 K1%=0:GOSUB 6570:PRINT:GOSUB 6020:PRINT:PRINT
4070 PRINT:PRINT"     1 - Display items.
4080 PRINT:PRINT"     2 - Print items on the printer.
4090 PRINT:PRINT"     3 - Enter a new item.
4100 PRINT:PRINT"     4 - Delete the last entry in the file.
4110 PRINT:PRINT:COLOR 18
4120 PRINT TAB(28)"Enter function desired: ";:COLOR 7:SOUND 1300,.5
4130 KB$=INKEY$:IF KB$="" THEN 4130
4140 IF K1%=1 THEN CLOSE:GOTO 60
4150 IF KB$="1" THEN R%=0:GOTO 4400
4160 IF KB$="2" THEN 4660
4170 IF KB$="3" THEN 4200
4180 IF KB$="4" THEN 4580
4190 BEEP:GOTO 4130
4200 R%=0
4210 GOSUB 6570:GOSUB 6330
4220 R%=R%+1:GET#1,R%:IF A$="E" THEN 4380
4230 IF A$<>"A" THEN 4220
4240 LSET D$=MKI$(R%)
4250 SOUND 1300,.5:LSET A$="B":GOSUB 5460:IF K1%=1 THEN 4060
4260 LSET B$=FDATE$:PRINT TAB(41)"_____________________________________"
4270 INPUT"  Enter up to 37 Char. for description: ",KB$:IF K1%=1 THEN 4200
4280 IF LEN(KB$)<38 THEN 4300
4290 BEEP:GOTO 4270
4300 LSET G$=KB$:INPUT"  Enter AMOUNT: ",KB#:IF K1%=1 THEN 4200
4310 LSET C$=MKD$(KB#):INPUT"  Enter EXPENSE CODE: ",KB%:IF K1%=1 THEN 4200
4320 IF KB%>9 AND KB%<46 THEN 4340
4330 BEEP:GOTO 4310
4340 LSET E$=MKI$(KB%):PRINT"  Enter a 'Y' if this item could be a tax ";
4350 INPUT" deduction: ",KB$:IF K1%=1 THEN 4200
4360 IF KB$="y" OR KB$="Y" THEN LSET F$="Y" ELSE LSET F$="N"
4370 PUT#1,R%:GOTO 4210
4380 BEEP:PRINT:COLOR 30:PRINT"Cash expenditures file is full.
4390 COLOR 7:PRINT:GOSUB 6630: GOTO 4060
4400 GOSUB 6570:GOSUB 6670:IF K1%=1 THEN 4060
4410 GOSUB 6780:IF K1%=1 THEN 4060
4420 GOSUB 6570:GOSUB 6270:GOSUB 6040:B%=0
4430 R%=R%+1:GET#1,R%:IF A$="E" THEN 4550
4440 IF A$="A" THEN 4550
4450 IF K1%=1 THEN 4060
4460 Y3$=RIGHT$(B$,2):D3$=LEFT$(B$,2)+MID$(B$,4,2)
4470 IF Y1$=Y2$ THEN 4510
4480 IF Y3$=Y1$ THEN 4560
4490 IF Y3$=Y2$ THEN 4570
4500 IF Y3$>Y1$ AND Y3$<Y2$ THEN 4530 ELSE 4430
4510 IF Y3$<>Y2$ THEN 4430
4520 IF D3$<D1$ OR D3$>D2$ THEN 4430
4530 GOSUB 6120:B%=B%+1:IF B%<20 THEN 4430
4540 B%=0:GOSUB 6630:IF K1%=1 THEN 4060 ELSE 4420
4550 PRINT"   End of file.":GOSUB 6630:GOTO 4060
4560 IF D3$=>D1$ THEN 4530 ELSE 4430
4570 IF D3$>D2$ THEN 4430 ELSE 4530
4580 GOSUB 6570:R%=0
4590 PRINT"To DELETE the last entry ... enter the word 'PROCEED' :";
4600 INPUT"  ",KB$:IF K1%=1 THEN 4060
4610 IF KB$="PROCEED" OR KB$="proceed" THEN 4630
4620 BEEP:GOTO 4590
4630 R%=R%+1:GET#1,R%:IF A$="B" THEN 4630
4640 IF R%=1 THEN 4060
4650 LSET A$="A":PUT#1,R%-1:GOTO 4060
4660 KEY(9) ON:KEY(10) ON:R%=0:GOSUB 6570:GOSUB 6670:IF K1%=1 THEN 4860
4670 GOSUB 6780:IF K1%=1 THEN 4860
4680 GOSUB 6570:B%=0:E%=1:PRINT"  Insure that the printer is ready."
4690 SOUND 500,1:GOSUB 6630:IF K1%=1 THEN 4860
4700 CLS:PRINT:PRINT"  To temporarily stop the printer, press the F9 key.
4710 PRINT:PRINT"  To STOP the printer and return to MENU, press the 'F1' key.
4720 KB1$="Cash Expenditures.":GOSUB 6600
4730 R%=R%+1:GET#1,R%:IF A$<>"B" THEN 4850
4740 IF K1%=1 THEN 4860
4750 IF K9%=1 THEN LOCATE 24,5:PRINT"Printer stopped by F9 key, to continue press F10 key.";:GOTO 4740
4760 Y3$=RIGHT$(B$,2):D3$=LEFT$(B$,2)+MID$(B$,4,2)
4770 IF Y1$=Y2$ THEN 4810
4780 IF Y3$=Y1$ THEN 4870
4790 IF Y3$=Y2$ THEN 4880
4800 IF Y3$>Y1$ AND Y3$<Y2$ THEN 4830 ELSE 4730
4810 IF Y3$<>Y2$ THEN 4730
4820 IF D3$<D1$ OR D3$>D2$ THEN 4730
4830 GOSUB 6150:B%=B%+1:IF B%< 58 THEN 4730
4840 B%=0:E%=E%+1:LPRINT CHR$(140):GOTO 4720
4850 LPRINT"* * END OF FILE * *";:LPRINT CHR$(140)
4860 KEY(9) OFF:KEY(10) OFF:GOTO 4060
4870 IF D3$=>D1$ THEN 4830 ELSE 4730
4880 IF D3$>D2$ THEN 4730 ELSE 4830
4890 GOSUB 6570:LOCATE 20,20:PRINT"Reading files.... Please stand by..."
4900 LOCATE 1,1
4910 B#=0:GOSUB 5980:R%=1:GET#1,R%:IF A$="B" THEN 4920 ELSE 4990
4920 A#=CVD(C$)
4930 R%=R%+1:GET#1,R%:IF A$="E" THEN 4970
4940 IF A$<>"B" AND A$<>"M" THEN 4930
4950 IF CVI(E$)=2 THEN A#=A#+CVD(C$) ELSE A#=A#-CVD(C$)
4960 GOTO 4930
4970 PRINT"  Checking Account #1 . . . . . . . . ";
4980 PRINT USING"$$######,.##";A#:PRINT:B#=A#
4990 CLOSE:GOSUB 5990:R%=1:GET#1,R%:IF A$="B" THEN 5000 ELSE 5070
5000 A#=CVD(C$)
5010 R%=R%+1:GET#1,R%:IF A$="E" THEN 5050
5020 IF A$<>"B" AND A$<>"M" THEN 5010
5030 IF CVI(E$)=2 THEN A#=A#+CVD(C$) ELSE A#=A#-CVD(C$)
5040 GOTO 5010
5050 PRINT"  Checking Account #2 . . . . . . . . ";
5060 PRINT USING"$$######,.##";A#:PRINT:B#=B#+A#
5070 CLOSE:GOSUB 6000:R%=1:GET#1,R%:IF A$="B" THEN 5080 ELSE 5150
5080 A#=CVD(C$)
5090 R%=R%+1:GET#1,R%:IF A$="E" THEN 5130
5100 IF A$<>"B" AND A$<>"M" THEN 5090
5110 IF CVI(E$)=2 THEN A#=A#+CVD(C$) ELSE A#=A#-CVD(C$)
5120 GOTO 5090
5130 PRINT"  Checking Account #3 . . . . . . . . ";
5140 PRINT USING"$$######,.##";A#:PRINT:B#=B#+A#
5150 CLOSE:GOSUB 5710:R%=1:GET#1,R%:IF A$="B" THEN 5160 ELSE 5200
5160 A#=CVD(E$)
5170 R%=R%+1:GET#1,R%:IF A$="E" OR A$="A" THEN 5180 ELSE 5160
5180 PRINT"  Savings Account #1. . . . . . . . . ";
5190 PRINT USING"$$######,.##";A#:PRINT:B#=B#+A#
5200 CLOSE:GOSUB 5720:R%=1:GET#1,R%:IF A$="B" THEN 5210 ELSE 5250
5210 A#=CVD(E$)
5220 R%=R%+1:GET#1,R%:IF A$="E" OR A$="A" THEN 5230 ELSE 5210
5230 PRINT"  Savings Account #2. . . . . . . . . ";
5240 PRINT USING"$$######,.##";A#:PRINT:B#=B#+A#
5250 CLOSE:A#=0:GOSUB 5610:R%=1:GET#1,R%:IF A$<>"A" AND A$<>"B" THEN 5330
5260 IF A$="B" THEN 5290
5270 R%=R%+1:GET#1,R%:IF A$="E" THEN 5310
5280 IF A$<>"B" THEN 5270
5290 IF D$="A" THEN A#=A#+CVD(C$) ELSE A#=A#-CVD(C$)
5300 GOTO 5270
5310 PRINT"  Special Accounts. . . . . . . . . . ";
5320 PRINT USING"$$######,.##";A#:PRINT:B#=B#+A#
5330 PRINT TAB(38) STRING$(16,196)
5340 PRINT:PRINT:PRINT"  Total in all accounts . . . . . . .";
5350 PRINT USING"$$#######,.##";B#:LOCATE 20,20
5360 PRINT TAB(56)"":CLOSE:GOSUB 6630:GOTO 60
5370 IF ERR=24 THEN RESUME
5380 IF ERR=6 THEN PRINT"Number too large.. re-enter.":RESUME
5390 ON ERROR GOTO 0:RESUME
5400 K1%=1:RETURN
5410 COLOR 7,0
5420 CLOSE:CLS:PRINT"Your session with the Financial Operating System has ended.
5430 PRINT:PRINT"Welcome to BASIC.":END
5440 K9%=1:RETURN
5450 K9%=0:LOCATE 24,1:PRINT TAB(65);:RETURN
5460 PRINT
5470 PRINT"  Enter date (0,4, or 6 digits in MMDDYY format):  ";
5480 X%=POS(0):Y%=CSRLIN:INPUT"",KB$
5490 IF LEN(KB$)=6 THEN 5550
5500 IF LEN(KB$)=4 THEN 5540
5510 IF LEN(KB$)=0 THEN 5530
5520 BEEP:GOTO 5470
5530 FDATE$=LEFT$(DATE$,2)+"-"+MID$(DATE$,4,2)+"-"+RIGHT$(DATE$,2):GOTO 5560
5540 FDATE$=LEFT$(KB$,2)+"-"+MID$(KB$,3,2)+"-"+RIGHT$(DATE$,2):GOTO 5560
5550 FDATE$=LEFT$(KB$,2)+"-"+MID$(KB$,3,2)+"-"+RIGHT$(KB$,2):GOTO 5560
5560 LOCATE Y%,X%:PRINT FDATE$:RETURN
5570 PRINT"ITEM#   DATE   TYPE   AMOUNT    RATE%";
5580 PRINT "        D E S C R I P T I O N"
5590 PRINT " "+STRING$(3,45)+"  "+STRING$(8,45)+"  "+CHR$(45)+"  ";
5600 PRINT STRING$(11,45)+"  "+STRING$(4,45)+"  "+STRING$(41,45):RETURN
5610 OPEN DRIVE$+":SPECIAL.FOS" AS 1 LEN=62
5620 FIELD#1,1 AS A$,8 AS B$,8 AS C$,1 AS D$,4 AS E$,40 AS G$:RETURN
5630 PRINT R% TAB(7) B$ TAB(17) D$;
5640 PRINT TAB(20) USING"$$#####,.##";CVD(C$);
5650 PRINT TAB(33) USING"##.#";CVS(E$);
5660 PRINT TAB(39) G$:RETURN
5670 PRINT"ITEM#  DATE  TYPE  THIS ENTRY    BALANCE";
5680 PRINT"            D E S C R I P T I O N"
5690 PRINT" "+STRING$(2,45)+"  "+STRING$(8,45)+"  "+CHR$(45)+"  ";
5700 PRINT STRING$(11,45)+"  "+STRING$(11,45)+"  "+STRING$(36,45);:RETURN
5710 OPEN DRIVE$+":SAVINGS1.FOS" AS 1 LEN=62:GOTO 5730
5720 OPEN DRIVE$+":SAVINGS2.FOS" AS 1 LEN=62
5730 FIELD#1,1 AS A$,8 AS B$,8 AS C$,1 AS D$,8 AS E$,36 AS G$:RETURN
5740 PRINT:PRINT"  MOVING RECORDS IN SAVINGS FILE...":PRINT:R%=1
5750 GET#1,20:IF A$="A" THEN 5780
5760 A#=CVD(E$):IF R%=20 THEN RETURN
5770 GET#1,R%+1:PUT#1,R%:R%=R%+1:GOTO 5760
5780 IF R%=20 THEN RETURN
5790 GET#1,R%:IF A$="A" THEN RETURN
5800 R%=R%+1:A#=CVD(E$):GOTO 5780
5810 PRINT TAB(19);:COLOR 1
5820 PRINT"       S A V I N G S     A C C O U N T   1       ":COLOR 7:RETURN
5830 PRINT TAB(19);:COLOR 1
5840 PRINT"       S A V I N G S     A C C O U N T   2       ":COLOR 7:RETURN
5850 COLOR 18:PRINT"Savings account 1.":COLOR 7:RETURN
5860 COLOR 18:PRINT"Savings account 2.":COLOR 7:RETURN
5870 PRINT R% TAB(6) B$ TAB(16) D$;
5880 PRINT TAB(19) USING"$$#####,.##";CVD(C$);
5890 PRINT TAB(32) USING"$$#####,.##";CVD(E$);
5900 PRINT TAB(45) G$;:RETURN
5910 PRINT TAB(18);:COLOR 1
5920 PRINT"       C H E C K I N G   A C C O U N T   1       ":COLOR 7:RETURN
5930 PRINT TAB(18);:COLOR 1
5940 PRINT"       C H E C K I N G   A C C O U N T   2       ":COLOR 7:RETURN
5950 PRINT TAB(18);:COLOR 1
5960 PRINT"       C H E C K I N G   A C C O U N T   3       ":COLOR 7:RETURN
5970 OPEN DRIVE$+":CASHEXP.FOS" AS 1 LEN=59:GOTO 6010
5980 OPEN DRIVE$+":CHKCUR1.FOS" AS 1 LEN=59:GOTO 6010
5990 OPEN DRIVE$+":CHKCUR2.FOS" AS 1 LEN=59:GOTO 6010
6000 OPEN DRIVE$+":CHKCUR3.FOS" AS 1 LEN=59
6010 FIELD#1,1 AS A$,8 AS B$,8 AS C$,2 AS D$,2 AS E$,1 AS F$,37 AS G$:RETURN
6020 PRINT TAB(18);:COLOR 1
6030 PRINT"       C A S H    E X P E N D I T U R E S       ":COLOR 7:RETURN
6040 PRINT" ITEM#     DATE        AMOUNT    CODE TAX";
6050 PRINT"        D E S C R I P T I O N"
6060 PRINT" "+STRING$(5,45)+"   "+STRING$(8,45)+"   "+STRING$(11,45);
6070 PRINT"   "+STRING$(2,45)+"   "+CHR$(45)+"   "+STRING$(37,45);:RETURN
6080 LPRINT" ITEM#     DATE        AMOUNT    CODE TAX";
6090 LPRINT"        D E S C R I P T I O N"
6100 LPRINT" "+STRING$(5,45)+"   "+STRING$(8,45)+"   "+STRING$(11,45);
6110 LPRINT"   "+STRING$(2,45)+"   "+CHR$(45)+"   "+STRING$(37,45);:RETURN
6120 D%=CVI(D$):C%=CVI(E$):A#=CVD(C$):PRINT D% TAB(10) B$ TAB(20);
6130 PRINT USING"$$######,.##";A#;:PRINT TAB(34) C% TAB(40) F$ TAB(44) G$;
6140 RETURN
6150 D%=CVI(D$):C%=CVI(E$):A#=CVD(C$):LPRINT D% TAB(10) B$ TAB(20);
6160 LPRINT USING"$$######,.##";A#;:LPRINT TAB(34) C% TAB(40) F$;
6170 LPRINT TAB(44) G$;:RETURN
6180 PRINT CVI(K$) TAB(10) I$ TAB(20);
6190 PRINT USING"$$######,.##";CVD(J$);:PRINT TAB(34) CVI(L$);
6200 PRINT TAB(40) M$ TAB(44) N$;:RETURN
6210 LPRINT CVI(K$) TAB(10) I$ TAB(20);
6220 LPRINT USING"$$######,.##";CVD(J$);:LPRINT TAB(34) CVI(L$);
6230 LPRINT TAB(40) M$ TAB(44) LEFT$(N$,36):RETURN
6240 COLOR 18:PRINT"Checking account 1.";:COLOR 7:GOTO 6280
6250 COLOR 18:PRINT"Checking account 2.";:COLOR 7:GOTO 6280
6260 COLOR 18:PRINT"Checking account 3.";:COLOR 7:GOTO 6280
6270 COLOR 18:PRINT"Cash expenditures.";:COLOR 7
6280 PRINT TAB(44)"From:  " FD1$ "     Thru:  " FD2$:RETURN
6290 COLOR 18:PRINT"Checking account 1.":COLOR 7:RETURN
6300 COLOR 18:PRINT"Checking account 2.":COLOR 7:RETURN
6310 COLOR 18:PRINT"Checking account 3.":COLOR 7:RETURN
6320 FDATE$=LEFT$(DATE$,2)+"-"+MID$(DATE$,4,2)+"-"+RIGHT$(DATE$,2):RETURN
6330 COLOR 18
6340 PRINT TAB(19)"* * * *   E X P E N S E   C O D E S   * * * *":COLOR 7
6350 PRINT"10 - Appliances"TAB(29)"22 - Entertainment";
6360 PRINT TAB(57)"34 - Miscellaneous":PRINT"11 - Automobile";
6370 PRINT TAB(29)"23 - Food"TAB(57)"35 - Mortgage
6380 PRINT"12 - Capital Inv. (Auto)"TAB(29)"24 - Furniture";
6390 PRINT TAB(57)"36 - Paper/Magazines":PRINT"13 - Capital Inv. (Bldg)";
6400 PRINT TAB(29)"25 - Gasoline/Oil (auto)"TAB(57)"37 - Supplies
6410 PRINT"14 - Capital Inv. (Other)"TAB(29)"26 - Gas/Oil (Heating)";
6420 PRINT TAB(57)"38 - Taxes":PRINT"15 - Cash";
6430 PRINT TAB(29)"27 - Hobbies"TAB(57)"39 - Telephone
6440 PRINT"16 - Clothing"TAB(29)"28 - Insurance";
6450 PRINT TAB(57)"40 - Tools":PRINT"17 - Dental";
6460 PRINT TAB(29)"29 - Interest"TAB(57)"41 - Tractor/Mower
6470 PRINT"18 - Donations (Church)"TAB(29)"30 - Lawn/Garden";
6480 PRINT TAB(57)"42 - Transfer to Invest.";:PRINT"19 - Donations (Other)";
6490 PRINT TAB(29)"31 - Maint. (Bldg)"TAB(57)"43 - Transfer to Savings";
6500 PRINT"20 - Education"TAB(29)"32 - Maint. (Other)";
6510 PRINT TAB(57)"44 - Vacation";:PRINT"21 - Electricity";
6520 PRINT TAB(29)"33 - Medical"TAB(57)"45 - Water/sewer":RETURN
6530 OPEN DRIVE$+":CHKCAN1.FOS" AS 2 LEN=59:GOTO 6560
6540 OPEN DRIVE$+":CHKCAN2.FOS" AS 2 LEN=59:GOTO 6560
6550 OPEN DRIVE$+":CHKCAN3.FOS" AS 2 LEN=59
6560 FIELD#2,1 AS H$,8 AS I$,8 AS J$,2 AS K$,2 AS L$,1 AS M$,37 AS N$:RETURN
6570 CLS:LOCATE 25,72:GOSUB 6320:PRINT FDATE$:LOCATE 1,1:RETURN
6580 LPRINT KB1$ TAB(48)"DATE: " FDATE$ TAB(70)"PAGE: "E%
6590 LPRINT:GOSUB 6080:RETURN
6600 LPRINT KB1$;
6610 LPRINT TAB(41) FD1$ "  THRU  " FD2$ TAB(70)"PAGE: " E%
6620 LPRINT:GOSUB 6080:RETURN
6630 LOCATE 25,30:COLOR 18:PRINT"Press any key to continue...";:COLOR 7
6640 KB$=INKEY$:IF KB$="" THEN 6640 ELSE RETURN
6650 LOCATE 25,30:PRINT SPC(30);:RETURN
6660 PRINT USING"$$######,.##";CVD(J$);:PRINT TAB(34) CVI(L$);
6670 PRINT
6680 PRINT"  Enter starting date (0,4,or 6 digits in MMDDYY format):  ";
6690 X%=POS(0):Y%=CSRLIN:INPUT"",KB$
6700 IF LEN(KB$)=6 THEN 6760
6710 IF LEN(KB$)=4 THEN 6750
6720 IF LEN(KB$)=0 THEN 6740
6730 BEEP:GOTO 6680
6740 FD1$=LEFT$(DATE$,2)+"-"+MID$(DATE$,4,2)+"-"+RIGHT$(DATE$,2):Y1$=RIGHT$(FD1$,2):D1$=LEFT$(FD1$,2)+MID$(FD1$,4,2):GOTO 6770
6750 FD1$=LEFT$(KB$,2)+"-"+MID$(KB$,3,2)+"-"+RIGHT$(DATE$,2):Y1$=RIGHT$(FD1$,2):D1$=(KB$):GOTO 6770
6760 FD1$=LEFT$(KB$,2)+"-"+MID$(KB$,3,2)+"-"+RIGHT$(KB$,2):Y1$=RIGHT$(KB$,2):D1$=LEFT$(KB$,4)
6770 LOCATE Y%,X%:PRINT FD1$:RETURN
6780 PRINT
6790 PRINT"  Enter ending date (0,4,or 6 digits in MMDDYY format):  ";
6800 X%=POS(0):Y%=CSRLIN:INPUT"",KB$
6810 IF LEN(KB$)=6 THEN 6870
6820 IF LEN(KB$)=4 THEN 6860
6830 IF LEN(KB$)=0 THEN 6850
6840 BEEP:GOTO 6790
6850 FD2$=LEFT$(DATE$,2)+"-"+MID$(DATE$,4,2)+"-"+RIGHT$(DATE$,2):Y2$=RIGHT$(FD2$,2):D2$=LEFT$(FD2$,2)+MID$(FD2$,4,2):GOTO 6880
6860 FD2$=LEFT$(KB$,2)+"-"+MID$(KB$,3,2)+"-"+RIGHT$(DATE$,2):Y2$=RIGHT$(FD2$,2):D2$=(KB$):GOTO 6880
6870 FD2$=LEFT$(KB$,2)+"-"+MID$(KB$,3,2)+"-"+RIGHT$(KB$,2):Y2$=RIGHT$(KB$,2):D2$=LEFT$(KB$,4)
6880 LOCATE Y%,X%:PRINT FD2$:RETURN
